Collection of Tools & Utilities/Collection of Tools and Utilities.iso/ada/gwuada_8.zip/DOC.ZIP/WORMS.ADA

Text File | 1993-08-18 | 10KB | 377 lines

--
--    Program : Worms.ada
--    Purpose : This program is based on the UNIX game worms.  It is
--        implemented to show how tasks can be used in ADA.  It
--        is interesting since the Worms program could really be
--        implemented as a sequential program.  This implementation
--        shows how tasks can be used to simplify the design of a
--        sequential program.  By defining the Worms as individual
--        tasks, the programmer only has to worry about defining the
--        behavior of a single Worm, and then creating multiple
-        instantiations of that Worm.
--
--    To use with GWUMON : To use this program with GWUMON, from the command
--              line type:
--                       adacomp -a -b -mworms worms.ada
--                       gwumon -mworms
--
--    On the intial setup screen, choose 'Y' to the questions if tasks are
--            used.  Also, set the intial speed to 10, the fastest speed
--        (the monitor will still run slow.  To get a better feel for
--        how the worms run, try running it once not through the
--        monitor).  The first four windows which will show up will be
--        the main procedure WORMS, the task SCREEN, and two instances
--        of the WORM task.  Notice how the WORM task interacts with
--        SCREEN task.
--
--
WITH Text_IO; USE Text_IO;

PACKAGE My_Int_IO IS
  NEW Text_IO.Integer_IO (Num => Integer);
--
--  Screen controls the actual printing of the characters to the screen.
--
PACKAGE Screen IS

    ScreenDepth: CONSTANT INTEGER := 24;
    ScreenWidth: CONSTANT INTEGER := 80;

    SUBTYPE DEPTH IS INTEGER RANGE 1..ScreenDepth;
    SUBTYPE WIDTH is INTEGER RANGE 1..ScreenWidth;

    PROCEDURE ClearScreen;
    PROCEDURE MoveCursor(Column : Width; Row : Depth);
    PROCEDURE Beep(HowMany: POSITIVE);
END Screen;

--
--  Screen_IO contains the task which controls the concurrency in the
--  I/O to the screen.
--
WITH Screen;
USE Screen;
PACKAGE Screen_IO IS

    TASK Terminal IS
        ENTRY WriteAt( Column : Width; Row : Depth; What : Character );
    END Terminal;
END Screen_IO;

--::::::::::
--random.ads
--::::::::::
PACKAGE Random IS

-- Simple pseudo-random number generator package.
-- Adapated from the Ada literature by
-- Michael B. Feldman, The George Washington University, November 1990.

  PROCEDURE Set_Seed (N : Positive);

  FUNCTION  Unit_Random RETURN Float;

    --returns a float >=0.0 and <1.0

  FUNCTION  Random_Int (N : Positive) RETURN Positive;

    --return a random integer in the range 1..N

END Random;

--
-- Creatures is the package in which worms resides.
--

PACKAGE Creatures IS

    TASK TYPE Worm IS
        ENTRY Init_Worm( Symbol : IN CHARACTER  );
    END Worm;

    TYPE Coordinate IS
        RECORD
            x,y : Integer;
        END RECORD;

    Maximum_xy : Coordinate;
    Minimum_xy : Coordinate;

PRIVATE
    Max_Length : CONSTANT INTEGER :=6;
    SUBTYPE Length IS POSITIVE RANGE 1..Max_Length;
    TYPE Worm_Definition IS ARRAY(Length) of Coordinate;
    FUNCTION New_Direction RETURN INTEGER;
    PROCEDURE Move_Worm( Worm_Position : IN OUT Worm_Definition;
                         Symbol : IN CHARACTER );
END Creatures;

--
--  Implementation of the Screen Package
--
with TEXT_IO;
with My_Int_IO;

PACKAGE BODY Screen is

    PROCEDURE Beep(HowMany: POSITIVE) IS
    BEGIN
        FOR count IN 1..HowMany LOOP
            Text_IO.put( Item => ASCII.BEL);
        END LOOP;
    END Beep;

    PROCEDURE ClearScreen IS
    BEGIN
        Text_IO.Put(Item => ASCII.ESC);
        Text_IO.Put (Item => "[2J" );
    END ClearScreen;

    PROCEDURE MoveCursor(Column : Width; Row : Depth) IS
    BEGIN
        Text_IO.New_Line;
        Text_IO.Put (Item => ASCII.ESC);
        Text_IO.Put ("[");
        My_Int_IO.Put (Item => Row, Width => 1);
        Text_IO.Put (";");
        My_Int_IO.Put (Item => Column, Width => 1);
        Text_IO.Put ("f");
    END MoveCursor;
END Screen;


--
--  Implementation of the Screen_IO package
--

with Text_IO;
with Screen;
use Screen;
PACKAGE BODY Screen_IO IS

    TASK BODY Terminal IS

    BEGIN
       Screen.ClearScreen;
       LOOP
            SELECT
                ACCEPT WriteAt(Column : Width; Row : Depth; What : Character) DO
                    Screen.MoveCursor( Column, Row );
                    Text_IO.Put( What );
                END WriteAt;
            OR
                TERMINATE;
            END SELECT;
       END LOOP;
    END Terminal;
END Screen_IO;

--::::::::::
--random.adb
--::::::::::
WITH Calendar;
USE  Calendar;

PACKAGE BODY Random IS

-- Body of random number generator package.
-- Adapted from the Ada literature by
-- Michael B. Feldman, The George Washington University, November 1990.

  Modulus      : CONSTANT := 9317;

  TYPE Int_16 IS RANGE - 2 ** 15 .. 2 ** 15 - 1;

  TYPE Int_32 IS RANGE - 2 ** 31 .. 2 ** 31 - 1;

  SUBTYPE Seed_Range IS Int_16 RANGE 0 .. (Modulus - 1);

  Seed,
  Default_Seed : Seed_Range;

  PROCEDURE Set_Seed (N : Positive) IS SEPARATE;

  FUNCTION  Unit_Random RETURN Float IS SEPARATE;

  FUNCTION  Random_Int (N : Positive) RETURN Positive IS SEPARATE;
BEGIN
  Default_Seed := Int_16 (Int_32 (Seconds (Clock)) MOD Modulus);
  Seed := Default_Seed;
END Random;

SEPARATE (Random)

PROCEDURE Set_Seed (N : Positive) IS
BEGIN
  Seed := Seed_Range (N);
END Set_Seed;

SEPARATE (Random)

FUNCTION  Unit_Random RETURN Float IS
  Multiplier : CONSTANT := 421;
  Increment  : CONSTANT := 2073;
  Result     : Float;
BEGIN
  Seed := (Multiplier * Seed + Increment) MOD Modulus;
  Result := Float (Seed) / Float (Modulus);
  RETURN Result;
EXCEPTION
  WHEN Constraint_Error | Numeric_Error =>
    Seed := Int_16 ((Multiplier * Int_32 (Seed) + Increment) MOD Modulus);
    Result := Float (Seed) / Float (Modulus);
    RETURN Result;

END Unit_Random;

SEPARATE (Random)

FUNCTION  Random_Int (N : Positive) RETURN Positive IS
  Result : Integer RANGE 1 .. N;
BEGIN
  Result := Integer (Float (N) * Unit_Random + 0.5);
  RETURN Result;
EXCEPTION
  WHEN Constraint_Error | Numeric_Error =>
    RETURN 1;

END Random_Int;

--
--  Implementation of the Creature.  In this case, it is a worm.
--

WITH Screen; USE Screen;
WITH Screen_IO; USE Screen_IO;
WITH Random; USE Random;
PACKAGE BODY Creatures IS

--
--  New_Direction finds the new direction for the worm to move
--

    FUNCTION New_Direction RETURN INTEGER IS
        Direction : Integer;
    BEGIN
        Direction := Random.Random_Int(10);
        IF Direction > 5 THEN
            Direction := -1;
    ELSE
        Direction := 1;
        END IF;
        RETURN Direction;
    END New_Direction;

--
--  Move_Worm actually moves the worm
--

    PROCEDURE Move_Worm( Worm_Position : IN OUT Worm_Definition;
                         Symbol : IN CHARACTER ) IS
    BEGIN

        Terminal.WriteAt( Worm_Position(Max_Length).x,
                          Worm_Position(Max_Length).y, ' ' );

        FOR I in REVERSE 2..Max_Length LOOP
            Worm_Position(I) := Worm_Position(I-1);
            Terminal.WriteAt( Worm_Position(I).x, Worm_Position(I).y,
                               Symbol );
        END LOOP;

        Worm_Position(1).x := Worm_Position(1).x + New_Direction;
        IF Worm_Position(1).x < Minimum_xy.x THEN
            Worm_Position(1).x := Minimum_xy.x;
        END IF;
        IF Worm_Position(1).x > Maximum_xy.x THEN
            Worm_Position(1).x := Maximum_xy.x;
        END IF;

        Worm_Position(1).y := Worm_Position(1).y + New_Direction;
        IF Worm_Position(1).y < Minimum_xy.y THEN
            Worm_Position(1).y := Minimum_xy.y;
        END IF;
        IF Worm_Position(1).y > Maximum_xy.y THEN
            Worm_Position(1).y := Maximum_xy.y;
        END IF;

        Terminal.WriteAt( Worm_Position(1).x, Worm_Position(1).y,
                               Symbol );
    END;

--
--  This is the body for the worm task.
--

    TASK BODY W